home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)TA / (A)TAA.ADF / Puzzle Pro v1.02 (.txt) < prev    next >
AmigaBASIC Source Code  |  1986-11-06  |  11KB  |  451 lines
  1. CLEAR ,20000
  2. CLEAR ,55000
  3. WINDOW CLOSE 1
  4. SCREEN 2,320,200,5,1
  5. WINDOW 2,"Puzzle Pro v1.02 by Syd L. Bolton",,16,2
  6. RANDOMIZE TIMER
  7. PALETTE 0,0,0,0
  8. DEFINT a-z
  9. DIM a(203,49),s(49),x(49),y(49),state(49),s$(49),scolor!(31,3),ocolor!(31,3)
  10. s1$=STRING$(26,0)
  11. POKE SADD(s1$)+11,5
  12. POKE SADD(s1$)+15,20
  13. POKE SADD(s1$)+19,20
  14. POKE SADD(s1$)+21,24
  15. POKE SADD(s1$)+23,31
  16. CLS
  17. LINE (57,38)-(263,142),3,b
  18. LINE (56,37)-(264,143),3,b
  19. f$="Puzzle Pro.pzl"
  20. GOSUB GetPuzzle
  21. FOR i=0 TO 31
  22. FOR j=1 TO 3
  23. ocolor!(i,j)=scolor!(i,j)
  24. NEXT
  25. NEXT
  26. FOR c=0 TO 4
  27. FOR r=0 TO 9
  28. PUT (60+r*20,40+c*20),a(0,c*10+r)
  29. NEXT:NEXT
  30. MENU 1,0,1,"Puzzle"
  31. MENU 1,1,1,"Start   "
  32. MENU 1,2,1,"Open    "
  33. MENU 1,3,1,"Cmd File"
  34. MENU 1,4,1,"Create  "
  35. MENU 1,5,1,"Quit    "
  36. MENU 2,0,1,"Options"
  37. MENU 2,1,1,"  Lines  "
  38. MENU 2,2,1,"  Dots   "
  39. MENU 2,3,1,"  Boxes  "
  40. MENU 2,4,1,"  F.Boxes"
  41. MENU 2,5,1,"  Ovals  "
  42. MENU 2,6,1,"  F.Ovals"
  43. MENU 3,0,1,"About..."
  44. MENU 3,1,1,"Author "
  45. MENU 3,2,1,"Game   "
  46. MENU 3,3,1,"Playing"
  47. MENU 3,4,1,"Updates"
  48. MENU 4,0,1,""
  49. ON ERROR GOTO 0
  50. ON MENU GOSUB menuhandler
  51. MENU ON
  52. Forever: GOTO Forever
  53. menuhandler:            
  54. a=MENU(0):b=MENU(1)  
  55. IF a=1 THEN MENU OFF:ON b GOSUB Main,OpenPuzzle,CmdFile,create,quit:MENU ON:RETURN
  56. IF a=2 THEN
  57. c(b)=1-c(b)
  58. MENU 2,b,c(b)+1  
  59. END IF
  60. IF a=3 THEN MENU OFF:GOSUB About:MENU ON:RETURN
  61. RETURN
  62. Main:
  63. IF getpuz THEN CmdGet
  64. CLS
  65. LOCATE 1,1:COLOR 1:INPUT "Difficulty Level (1-5)";diff
  66. IF diff<1 OR diff>5 THEN Main
  67. DiffLevel:
  68. diff=(6-diff)*500
  69. LINE (57,38)-(263,142),3,b
  70. LINE (56,37)-(264,143),3,b
  71. LINE (60,40)-(260,140),0,bf
  72. FOR i=0 TO 49
  73. s(i)=i:state(i)=1
  74. NEXT
  75. FOR i=0 TO 49
  76. SWAP s(i),s(INT(RND*50))
  77. NEXT
  78. LOCATE 1,1:PRINT STRING$(38,32)
  79. FOR i=0 TO 11
  80. PUT (24.5*i,14),a(0,s(i)):x(s(i))=24.5*i:y(s(i))=14
  81. PUT (24.5*i,146),a(0,s(i+13)):x(s(i+13))=24.5*i:y(s(i+13))=146
  82. NEXT
  83. PUT (292,14),a(0,s(12)):x(s(12))=292:y(s(12))=14
  84. PUT (292,146),a(0,s(25)):x(s(25))=292:y(s(25))=146
  85. FOR i=26 TO 30
  86. PUT (0,36+22*(i-26)),a(0,s(i)):x(s(i))=0:y(s(i))=36+22*(i-26)
  87. PUT (24,36+22*(i-26)),a(0,s(i+5)):x(s(i+5))=24:y(s(i+5))=36+22*(i-26)
  88. PUT (270,36+22*(i-26)),a(0,s(i+10)):x(s(i+10))=270:y(s(i+10))=36+22*(i-26)
  89. PUT (292,36+22*(i-26)),a(0,s(i+15)):x(s(i+15))=292:y(s(i+15))=36+22*(i-26)
  90. NEXT
  91. FOR i=46 TO 48
  92. PUT (122+25*(i-46),168),a(0,s(i)):x(s(i))=122+25*(i-46):y(s(i))=168
  93. NEXT
  94. LOCATE 23,7:PRINT "PAUSE";:LOCATE 23,31:PRINT "CHEAT";
  95. LINE (45,174)-(89,184),3,b
  96. LINE (237,174)-(281,184),3,b
  97. p=s(49)
  98. c=INT(p/10):r=p-c*10
  99. PUT (60+r*20,40+c*20),a(0,s(49)):state(s(49))=0
  100. np=49
  101. t!=TIMER
  102. done=0:ms=0    
  103. loop:
  104. WHILE ms=0
  105. ms=MOUSE(0)
  106. LOCATE 1,17:PRINT "Timer:";INT(TIMER-t!)
  107. IF INT(TIMER-t!)=>diff THEN done=1:LOCATE 1,1:PRINT STRING$(38,32):LOCATE 1,17:COLOR 1:PRINT"TIME UP!":ms=1
  108. IF INKEY$="q" OR INKEY$="Q" THEN LOCATE 1,1:PRINT STRING$(38,32):LOCATE 1,16:COLOR 1:PRINT"GAME OVER":done=1:ms=1
  109. WEND
  110. IF done THEN lastpuz=0:getpuz=0:RETURN
  111. ms=0
  112. x=MOUSE(1):y=MOUSE(2)
  113. piece=-1
  114. FOR i=0 TO 49
  115. IF (x>=x(i) AND x<=x(i)+20) AND (y>=y(i) AND y<=y(i)+20) THEN IF state(i)=1 THEN piece=i:i=49
  116. NEXT
  117. IF piece>-1 THEN There
  118. IF x>45 THEN IF x<89 THEN IF y>174 THEN IF y<184 THEN pause
  119. IF x>237 THEN IF x<281 THEN IF y>174 THEN IF y<184 THEN cheat
  120. IF piece=-1 THEN PRINT CHR$(7);:zz=MOUSE(0):GOTO loop
  121. There:
  122. PUT (x(piece),y(piece)),a(0,piece)
  123. OBJECT.SHAPE 1,s1$+s$(piece)
  124. OBJECT.X 1,x(piece):OBJECT.Y 1,y(piece)
  125. x=x(piece):y=y(piece)
  126. OBJECT.ON 1
  127. yep:
  128. WHILE MOUSE(0)<0
  129. x=MOUSE(5):y=MOUSE(6)
  130. IF x<295 THEN OBJECT.X 1,x:OBJECT.Y 1,y  
  131. WEND
  132. x=x+3:y=y+3
  133. x=x-60:y=y-40
  134. IF x<0 OR y<0 OR x>260 OR y>140 THEN OBJECT.OFF 1:PUT (x(piece),y(piece)),a(0,piece):GOTO loop
  135. place=INT(x/20)+10*INT(y/20)
  136. IF place<>piece THEN OBJECT.OFF 1:PUT (x(piece),y(piece)),a(0,piece):GOTO loop
  137. OBJECT.OFF 1
  138. y=INT(place/10):x=place-y*10
  139. PUT (60+x*20,40+y*20),a(0,piece):state(piece)=0:np=np-1:IF np=0 THEN EndPuzzle
  140. GOTO loop
  141. pause:
  142. t2!=TIMER
  143. WINDOW 3,"<- Click here to resume",(63,51)-(257,138),8,2
  144. COLOR 1
  145. PRINT:PRINT:PRINT 
  146. PRINT " ***  *  * * *** *** **"
  147. PRINT " * * * * * * *   *   * *"
  148. PRINT " *** *** * * *** **  * *"
  149. PRINT " *   * * * *   * *   * *"
  150. PRINT " *   * * *** *** *** **"
  151. r!=1:g!=1:b!=1:in!=-0.03
  152. WHILE (WINDOW(7)<>0 AND WINDOW(1)=3)
  153. PALETTE 1,r!,g!,b!
  154. r!=r!+in!:IF r!>=1 THEN in!=-in! :ELSE IF r!<=0 THEN in!=-in!
  155. g!=r!:b!=r!  
  156. WEND
  157. WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
  158. PALETTE 1,scolor!(1,1),scolor!(1,2),scolor!(1,3)
  159. zz=MOUSE(0)
  160. t!=t!+(TIMER-t2!)
  161. GOTO loop
  162. cheat:
  163. WINDOW 3,"Cheat!",(57,39)-(263,142),0,2
  164. x=MOUSE(0)
  165. COLOR 2,0
  166. PRINT:PRINT" Remember, cheaters":PRINT:PRINT" pay for it." 
  167. COLOR 1,0
  168. LOCATE 9,2:PRINT"GIVE PIECE":LOCATE 9,15:PRINT"SHOW PUZZLE"
  169. LOCATE 11,11:PRINT"CANCEL"
  170. LINE (6,62)-(88,72),2,b
  171. LINE (111,62)-(200,72),2,b
  172. LINE (78,78)-(128,88),2,b
  173. cheatit:
  174. WHILE MOUSE(0)=0:WEND
  175. x=MOUSE(1):y=MOUSE(2)
  176. IF x>6 THEN IF x<88 THEN IF y>62 THEN IF y<72 THEN GivePiece
  177. IF x>111 THEN IF x<200 THEN IF y>62 THEN IF y<72 THEN ShowPuzzle
  178. IF x>78 THEN IF x<128 THEN IF y>78 THEN IF y<88 THEN WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2:WHILE MOUSE(0)<>0:WEND:GOTO loop
  179. GOTO cheatit
  180. GivePiece:
  181. WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
  182. FOR i=0 TO 49
  183. IF state(s(i))=1 THEN piece=s(i):i=49
  184. NEXT
  185. PUT (x(piece),y(piece)),a(0,piece)
  186. state(piece)=0
  187. y=INT(piece/10):x=piece-y*10
  188. PUT (60+x*20,40+y*20),a(0,piece):np=np-1:IF np=0 THEN EndPuzzle
  189. t!=t!-90
  190. WHILE MOUSE(0)<>0:WEND
  191. GOTO loop
  192. ShowPuzzle:
  193. WINDOW 3,"<- Click here to resume",,8
  194. CLS
  195. FOR c=0 TO 4
  196. FOR r=0 TO 9
  197. PUT (3+r*20,2+c*20),a(0,c*10+r)
  198. NEXT:NEXT
  199. ct!=TIMER
  200. WHILE (WINDOW(7)<>0 AND WINDOW(1)=3):WEND
  201. WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
  202. t!=t!-((TIMER-ct!)*5)
  203. WHILE MOUSE(0)<>0:WEND
  204. GOTO loop
  205. EndPuzzle:
  206. LOCATE 1,8:PRINT"Finished in";INT(TIMER-t!);"seconds."
  207. IF lastpuz THEN lastpuz=0:getpuz=0:RETURN
  208. IF getpuz THEN CmdGet
  209. RETURN
  210. GetPuzzle:
  211. ON ERROR GOTO DiskError
  212. OPEN f$ FOR INPUT AS #1
  213. INPUT#1,a$:IF a$<>"BPFF" THEN ERROR 53
  214. LOCATE 1,1:PRINT STRING$(38,32)
  215. LOCATE 1,15:PRINT "LOADING..."
  216. FOR i=0 TO 31
  217. INPUT#1,scolor!(i,1),scolor!(i,2),scolor!(i,3)
  218. NEXT
  219. FOR i=0 TO 49
  220. s$(i)=INPUT$(400,1)
  221. NEXT
  222. FOR i=0 TO 49
  223. FOR j=0 TO 203
  224. a(j,i)=CVI(INPUT$(2,1))
  225. NEXT j 
  226. NEXT i
  227. INPUT#1,Cycle
  228. CLOSE#1
  229. CLS
  230. LINE (57,38)-(263,142),3,b
  231. LINE (56,37)-(264,143),3,b
  232. FOR i=0 TO 31
  233. PALETTE i,scolor!(i,1),scolor!(i,2),scolor!(i,3)
  234. NEXT
  235. RETURN
  236. nothing:
  237. RETURN
  238. OpenPuzzle:
  239. WINDOW 3,"Open Puzzle",(63,51)-(257,138),0,2
  240. WINDOW OUTPUT 3
  241. COLOR 1:PRINT:PRINT "Enter Puzzle Filename:"
  242. LOCATE 9,4:PRINT "LOAD":LOCATE 9,16:PRINT "CANCEL"
  243. LINE (22,62)-(56,72),2,b
  244. LINE (118,62)-(168,72),2,b
  245. cancel=0:GOSUB GetString
  246. WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
  247. IF cancel THEN RETURN
  248. f$=in$+".pzl"
  249. GOSUB GetPuzzle
  250. LINE (60,40)-(260,140),0,bf
  251. RETURN
  252. GetString:
  253. in$=""
  254. LOCATE 5,2:COLOR 0,1:PRINT STRING$(23,32)
  255. Cursor:
  256. LOCATE 5,LEN(in$)+1:COLOR 0,2:PRINT " ":a$=""
  257. Waititout:
  258. a$=INKEY$:b=MOUSE(0):IF b=0 THEN IF a$="" THEN Waititout
  259. IF b THEN CheckM
  260. a=ASC(a$):IF a=8 THEN IF LEN(in$)>0 THEN in$=LEFT$(in$,LEN(in$)-1):LOCATE 5,LEN(in$)+2:COLOR 0,1:PRINT " ":GOTO Cursor
  261. IF a=13 THEN IF LEN(in$)>0 THEN RETURN
  262. IF (a>31 AND a<91 OR a>75 AND a<124) THEN IF LEN(in$)<23 THEN okkey
  263. GOTO Waititout
  264. CheckM:
  265. x=MOUSE(1):y=MOUSE(2)
  266. IF x>22 THEN IF x<56 THEN IF y>62 THEN IF y<72 THEN IF LEN(in$)>0 THEN RETURN
  267. IF x>118 THEN IF x<168 THEN IF y>62 THEN IF y<72 THEN cancel=1:RETURN
  268. GOTO Waititout
  269. okkey:
  270. in$=in$+a$:LOCATE 5,LEN(in$):COLOR 0,1:PRINT a$
  271. GOTO Cursor
  272. DiskError:
  273. CLOSE#1
  274. WINDOW 3,"Alert",(63,51)-(257,138),0,2
  275. COLOR 2,0
  276. IF ERR<50 THEN PRINT "Program Malfunction" :ELSE PRINT "Disk Error"
  277. PRINT:PRINT:COLOR 1,0:IF ERR=53 THEN PRINT"File Not Found!":GOTO Choice
  278. PRINT"Error:";ERR
  279. Choice:
  280. LOCATE 9,4:PRINT"RETRY":LOCATE 9,16:PRINT"CANCEL"
  281. LINE (22,62)-(65,72),2,b
  282. LINE (118,62)-(168,72),2,b
  283. MakeIt:
  284. WHILE MOUSE(0)=0:WEND
  285. x=MOUSE(5):y=MOUSE(6)
  286. IF x>22 THEN IF x<65 THEN IF y>62 THEN IF y<72 THEN WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2:MENU ON:RESUME NEXT
  287. IF x>118 THEN IF x<168 THEN IF y>62 THEN IF y<72 THEN WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2:MENU ON:RESUME WaitMenu
  288. GOTO MakeIt  
  289. create:
  290. nt=0
  291. FOR i=1 TO 6
  292. IF c(i)=1 THEN nt=nt+1
  293. NEXT
  294. IF nt=0 THEN PRINT CHR$(7);:RETURN
  295. CLS
  296. LINE (60,40)-(260,140),INT(RND*31)+1,bf
  297. et=120/nt
  298. WINDOW 3,"Create Puzzle",(57,39)-(263,142),0,2
  299. COLOR 1,0
  300. PRINT:PRINT:PRINT"Please wait while I make"
  301. PRINT:PRINT"your puzzle..."
  302. WINDOW OUTPUT 2
  303. IF c(4)=1 THEN
  304. FOR i=1 TO et
  305. GOSUB pickrnd
  306. LINE (x1+60,y1+40)-(x2+60,y2+40),INT(RND*32),bf
  307. NEXT
  308. END IF                 
  309. IF c(6)=1 THEN
  310. FOR i=1 TO et
  311. GOSUB pickrnd
  312. x1=x1+60
  313. y1=y1+40
  314. r=x1-60
  315. IF r>160 THEN r=260-x1
  316. IF y1-r<40 THEN r=y1-39
  317. IF y1+r>140 THEN r=139-y1
  318. c=INT(RND*32)
  319. CIRCLE (x1,y1),INT(RND*r)/2+1,c
  320. PAINT (x1,y1),c,c  
  321. NEXT
  322. END IF
  323. IF c(3)=1 THEN
  324. FOR i=1 TO et
  325. GOSUB pickrnd
  326. LINE (x1+60,y1+40)-(x2+60,y2+40),INT(RND*32),b
  327. NEXT
  328. END IF
  329. IF c(5)=1 THEN
  330. FOR i=1 TO et
  331. GOSUB pickrnd
  332. x1=x1+60
  333. y1=y1+40
  334. r=x1-60
  335. IF r>160 THEN r=260-x1
  336. IF y1-r<40 THEN r=260-y1
  337. IF y1+r>140 THEN r=r=139-y1
  338. CIRCLE (x1,y1),INT(RND*r)/2+1,INT(RND*32)
  339. NEXT
  340. END IF
  341. IF c(1)=1 THEN
  342. FOR i=1 TO et
  343. GOSUB pickrnd
  344. LINE (x1+60,y1+40)-(x2+60,y2+40),INT(RND*32)
  345. NEXT i
  346. END IF
  347. IF c(2)=1 THEN
  348. FOR i=1 TO et*10
  349. GOSUB pickrnd
  350. PSET(x1+60,y1+40),INT(RND*32)
  351. NEXT
  352. END IF
  353. FOR c=0 TO 4
  354. FOR r=0 TO 9
  355. GET (r*20+60,c*20+40)-(r*20+79,c*20+59),a(0,c*10+r)
  356. NEXT:NEXT
  357. FOR i=0 TO 49
  358. s$(i)=""
  359. FOR j=3 TO 202
  360. s$(i)=s$(i)+MKI$(a(j,i))
  361. NEXT
  362. NEXT
  363. WINDOW CLOSE 3
  364. CLS
  365. LINE (57,38)-(263,142),3,b
  366. LINE (56,37)-(264,143),3,b
  367. FOR i=0 TO 31
  368. PALETTE i,ocolor!(i,1),ocolor!(i,2),ocolor!(i,3)
  369. NEXT
  370. RETURN
  371. pickrnd:
  372. x1=INT(RND*200)
  373. y1=INT(RND*100)
  374. x2=INT(RND*200)
  375. y2=INT(RND*100)
  376. RETURN
  377. quit:
  378. LOCATE 1,1:PRINT STRING$(38,32)
  379. LOCATE 1,9:COLOR 1:INPUT "Quit to system? (Y/N)";q$
  380. q$=UCASE$(LEFT$(q$,1))
  381. IF q$="Y" THEN SYSTEM
  382. IF q$="N" THEN LOCATE 1,1:PRINT STRING$(38,32):RETURN
  383. GOTO quit
  384. CmdFile:
  385. WINDOW 3,"Command File",(63,51)-(257,138),0,2
  386. COLOR 1:PRINT:PRINT"Filename:"
  387. LOCATE 9,4:PRINT"LOAD":LOCATE 9,16:PRINT"CANCEL"
  388. LINE (22,62)-(56,72),2,b
  389. LINE (118,62)-(168,72),2,b
  390. cancel=0:GOSUB GetString
  391. WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
  392. IF cancel THEN RETURN
  393. getpuz=1:puznum=0:d$=in$
  394. GOTO Main
  395. CmdGet:
  396. ON ERROR GOTO DiskError
  397. puznum=puznum+1
  398. OPEN d$ FOR INPUT AS #1
  399. FOR i=1 TO puznum
  400. INPUT #1,f$,diff
  401. NEXT
  402. INPUT #1,a$:IF UCASE$(a$)="END" THEN lastpuz=1
  403. CLOSE #1
  404. f$=f$+".pzl"
  405. GOSUB GetPuzzle
  406. GOTO DiffLevel
  407. About:
  408. WINDOW 3,"<- Click here to resume",(63,51)-(257,138),8,2
  409. COLOR 2
  410. ON b GOTO Author,Game,Playing,Updates
  411. Author:
  412. PRINT:PRINT"This program written by":PRINT:PRINT"   Syd L. Bolton"
  413. PRINT"   25 Frontenac Ave.":PRINT"   Brantford, Ontario"
  414. PRINT"   Canada  N3R 3B7":PRINT
  415. PRINT"I'm open to comments &":PRINT"suggestions!"
  416. GOTO CloseWin
  417. Game:
  418. PRINT:PRINT"   Puzzle Pro v1.02":PRINT
  419. PRINT"   Copyright ";CHR$(169);" 1987"
  420. PRINT"    Oston Software"
  421. PRINT:PRINT"This game is shareware,"
  422. PRINT"and may be freely dis-"
  423. PRINT"tributed. I do however"
  424. PRINT"ask for a donation."
  425. GOTO CloseWin
  426. Playing:
  427. PRINT:PRINT
  428. PRINT"For some instruction,"
  429. PRINT"& resident puzzles,"
  430. PRINT"read PUZZLE.PRO.DOC',"
  431. PRINT"located elsewhere on"
  432. PRINT"this disk."
  433. GOTO CloseWin
  434. Updates:
  435. PRINT"To receive a full"
  436. PRINT"manual, game updates,"
  437. PRINT"& puzzle data disks,"
  438. PRINT"register by sending a"
  439. PRINT"donation to me.  You"
  440. PRINT"will be informed of"
  441. PRINT"new releases, etc."
  442. PRINT:PRINT"I really hope you like"
  443. PRINT"this game!";
  444. GOTO CloseWin
  445. CloseWin:
  446. WHILE (WINDOW(7)<>0 AND WINDOW(1)=3)
  447. WEND
  448. WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
  449. RETURN
  450.     
  451.